;;######################################################################
;;
;; ViSta - The Visual Statistics System
;; Copyright (c) 1991-99 by Forrest W. Young
;; For further information contact the author at forrest@unc.edu
;;
;; This file configures WXLS32.INI, the windows initialization file,
;; with ViSta configuration, allowing for separate XLisp configuration
;;
;;######################################################################


(let ((*config-dialog* nil)
      (*ini-file* (strcat *default-path* "WXLS32.INI"))
      (choice 
       (cond 
         (*font-and-dir-setting-mode*
          (setf *font-setting-mode* nil)
          (setf *directory-setting-mode* nil)
          ;(setf *no-dir-dialog* nil)
          (setf choice 1))
         (*custom-dialog* 1)
         (*no-dir-dialog* 0)
         ((or *directory-setting-mode* *font-setting-mode*) 1)
         (t (choose-item-dialog 
             "Choose Type of Installation:"
             '("Standard Installation" "Custom Installation"))))))
  (if (not choice) (top-level))
  (setf choice (if (= choice 0) t nil))
  
  (defvar *progman-available*
          (let ((conv (dde-connect "progman")))
            (if conv (dde-disconnect conv))
            conv))
  
  (defproto preference-item-proto 
    '(section name default) () edit-text-item-proto)
  
  (defmeth preference-item-proto :isnew (section name default &rest args)
    (setf (slot-value 'section) section)
    (setf (slot-value 'name) name)
    (setf (slot-value 'default) default)
    (apply #'call-next-method default args))
  
  (defmeth preference-item-proto :configure ()
    (msw-write-profile-string (slot-value 'section)
                              (slot-value 'name)
                              (send self :text)
                              *ini-file*))
  
  
  (defproto directory-item-proto () () preference-item-proto)
  
  (defmeth directory-item-proto :isnew (section directory location)
    (call-next-method section ; "Xlisp" or "ViSta"
                      directory ;"Libdir" or "ViStaLibdir"
                      location  ;*default-path*
                      :text-length 35)
    )
  
  (defproto font-name-item-proto () () preference-item-proto)

(defmeth font-name-item-proto :isnew (section &optional 
                                       (font "MonoType.Com")
                                              (size 9))
  (call-next-method section "Font" font :text-length size))




(defproto font-size-item-proto () () preference-item-proto)

(defmeth font-size-item-proto :isnew (section &optional (size 9))
  (call-next-method section "FontSize" (format nil "~3d" size)
                    :text-length 5))

(defmeth font-size-item-proto :configure ()
  (let ((n (read-from-string (send self :text) nil)))
    (unless (integerp n)
            (send self :text (slot-value 'default)))
    (call-next-method)))




(defproto progman-item-proto () () edit-text-item-proto)

(defmeth progman-item-proto :exec (&rest args)
  (let ((conv (dde-connect "progman")))
   (when conv 
         (unwind-protect
          (dde-client-transaction conv :data (apply #'format nil args))
          (dde-disconnect conv)))))




(defproto progman-group-item-proto () () progman-item-proto)

(defun progman-group-exists (group)
  (let ((conv (dde-connect "progman")))
   (when conv 
         (unwind-protect
          (dde-client-transaction conv :type :request :item group)
          (dde-disconnect conv)))))

(defmeth progman-group-item-proto :configure ()
  (unless *font-setting-mode*
          (let ((group (send self :text)))
            (when (and *directory-setting-mode*
                       (progman-group-exists group))
                  (let ((delete))
                    (if (not choice)
                        (setf delete
                              (ok-or-cancel-dialog
                               (format nil "Delete existing ~a group?"
                                       group)))
                        (setf delete t))
                    (if delete
                        (send self :exec "[DeleteGroup(~a)]" group)
                        (throw 'cancel nil)))))
          (send self :exec "[CreateGroup(~a)]" (send self :text))))

(defproto progman-program-item-proto
 '(application directory icon x y) () progman-item-proto)

(defmeth progman-program-item-proto :isnew (n a d i x y)
  (setf (slot-value 'application) a)
  (setf (slot-value 'directory) d)
  (setf (slot-value 'icon) i)
  (setf (slot-value 'x) x)
  (setf (slot-value 'y) y)
  (call-next-method n))

(defmeth progman-program-item-proto :configure ()
  (send self :exec "[AddItem(~a\\~a,~a,,~d,~d,~d,~a)]"
        (send (slot-value 'directory) :text)
        (slot-value 'application)
        (send self :text)
        (slot-value 'icon)
        (slot-value 'x)
        (slot-value 'y)
        (send (slot-value 'directory) :text)))

(let* ((list-font-size 9)
       (graph-font-size 9)
       (startup-text-item (send text-item-proto :new "STARTUP:")) 
       (startup-dir-item 
        (send directory-item-proto :new "ViSta" "Libdir" *default-path*))
       (default-directory 
        (if (or (not *default-path*) (= 0 (length *default-path*)))
            (get-working-directory)
            (subseq *default-dir* 0 (- (length *default-dir*) 1))))
       (user-directory
        (if (AND *user-dir-name* (> 0 (length *user-dir-name*)))
            (subseq *user-dir-name* 0 (- (length *user-dir-name*) 1))
            (strcat default-directory "\\user\\")
            ))
       (prefs-directory
        (if (AND *prefs-dir-name* (> 0 (length *PREFS-dir-name*)))
            (subseq *prefs-dir-name* 0 (- (length *prefs-dir-name*) 1)) 
            (strcat default-directory "\\prefs\\")
            ))
       (users-dir-item (send directory-item-proto :new
                             "ViSta" "Userdir"
                             (if *changed-user-dir-name*
                                 *changed-user-dir-name*
                                  user-directory)))
       (prefs-dir-item (send directory-item-proto :new
                             "ViSta" "Prefdir" prefs-directory))
       (window-toggle-item (send toggle-item-proto :new 
          "Retain Main Window Size and Location between sessions."
          :value t))
       (list-font-item (send font-name-item-proto :new "Listener"))
       (list-font-size (msw-get-profile-string 
             "Listener" "FontSize" (strcat *default-path* "WXLS32.INI")))
       (list-font-size (if list-font-size list-font-size 9))
       (list-font-size-item (send font-size-item-proto :new 
                                  "Listener" list-font-size))
       (graph-font-item (send font-name-item-proto :new "Graphics"))
       (graph-font-size (msw-get-profile-string 
             "Graphics" "FontSize" (strcat *default-path* "WXLS32.INI")))
       (graph-font-size (if graph-font-size graph-font-size 9))
       (graph-font-size-item (send font-size-item-proto :new 
                                   "Graphics" graph-font-size))
       (print-font-item (send font-name-item-proto :new "Printer"))
       (print-font-size (msw-get-profile-string 
             "Printer" "FontSize" (strcat *default-path* "WXLS32.INI")))
       (print-font-size (if print-font-size print-font-size 9))
       (print-font-size-item (send font-size-item-proto :new 
                                   "Printer" print-font-size))
       (progman-item (send toggle-item-proto :new 
                           "Add the Following Program Group and Items to Start Menu"
                           :value nil))
       (group-name-item (send progman-group-item-proto :new
                              (format nil "ViSta")
                              ))
       (xls-name-item (send progman-program-item-proto :new
                            (format nil "ViSta")
                            "ViSta.exe"
                            startup-dir-item 2 30 20
                            ))
       (lspedit-name-item (send progman-program-item-proto :new
                                "LispEdit" "lspedit.exe"
                                startup-dir-item 0 90 20
                                )))

  (labels ((close-dialog () (send *config-dialog* :close))
           (configure ()
              (catch 'cancel
                  (send startup-dir-item :configure)
                  (send users-dir-item :configure)
                  (send prefs-dir-item :configure)
                  (send list-font-item :configure)
                  (send list-font-size-item :configure)
                  (send graph-font-item :configure);graph
                  (send graph-font-size-item :configure)
                  (send print-font-item :configure);graph
                  (send print-font-size-item :configure)
                  (when (and *progman-available*
                             (send progman-item :value))
                        (send group-name-item :configure)
                        (send xls-name-item :configure)
                        (send lspedit-name-item :configure))   
                  (if (send window-toggle-item :value)
                      (msw-write-profile-string 
                       "XLisp" "RecallMainFrame" "yes" *ini-file*)
                      (msw-write-profile-string 
                       "XLisp" "RecallMainFrame" "no"  *ini-file*))
                     
                  (when (not (msw-get-profile-string "xlisp" "libdir" *ini-file*))
                        (let ((libdir (msw-get-profile-string 
                                       "vista" "libdir" *ini-file*)))
                          (msw-write-profile-string 
                           "XLisp" "Libdir" libdir *ini-file*)))
                  (msw-write-profile-string "XLisp" "HideMainFrame" "yes" *ini-file*)
                  (setf *config-vistaxls* nil)
                  (setf *prefs-dir-name* *prefs-path*)
                     (setf *no-restart* t)
                     (setf *initial-install* nil)
                     (write-prefload-file)
                     (format t "Writing .INI file.~%")
                     (system "vista.exe")
                     (exit)
                    
                     );end catch
                      );msw-exit
           (quit () (exit)));msw-exit
    (let ((dir-items (list
                      ; startup-text-item 
                      
                      (list "Startup Directory:" startup-dir-item)
                      (list "User    Directory:" users-dir-item)
                      (list "Prefs   Directory:" prefs-dir-item)
                    ;  ini-dir-toggle-item 
                      window-toggle-item))
          
          (pm-items (list ;progman-text-item
                          
                          (list "Program Item Name:   " group-name-item)
                          (list "Name for ViSta.exe:  " xls-name-item)
                          (list "Name for lspedit.exe:" lspedit-name-item)))
          (font-items (list
                       (list
                        (list
                         (list "Listener Font:" list-font-item)
                         (list "Graphics Font:" graph-font-item)
                         (list "Printer  Font:" print-font-item))
                        (list
                         (list "Size:" list-font-size-item)
                         (list "Size:" graph-font-size-item)
                         (list "Size:" print-font-size-item)))))
          (cq-button (send button-item-proto :new "Configure and Restart"
                           :action #'configure))
          (q-button (send button-item-proto :new "Quit" :action #'quit))
          (c-button (send button-item-proto :new "Cancel" :action #'close-dialog))
          (buttons (list (list (send button-item-proto :new
                                     "Configure and Restart"
                                     :action #'configure)
                               (send button-item-proto :new
                                     "Quit"
                                     :action #'quit) ))))
      (cond 
        (choice (configure))
        ((and (not choice) 
              (not *font-setting-mode*) 
              (not *directory-setting-mode*))
         (setf *config-dialog*
               (send dialog-proto :new
               (append dir-items
                       font-items
                       (list progman-item)
                       (if *progman-available*
                           (list (list pm-items (list buttons)))
                           buttons)
                       )    
               :title "ViSta Setup"
               :location '(50 50)))
         (top-level))
        (t
         (setf *config-dialog*
                (send dialog-proto :new
                (cond 
                  (*font-setting-mode*
                   (append font-items 
                           (list (list cq-button c-button))));buttons
                  (*directory-setting-mode*
                   (append dir-items 
                           (list progman-item)
                           (if *progman-available* pm-items)
                           (list (list cq-button c-button))));buttons
                  )
                :title "ViSta Setup"
                :location '(50 50)))))
      ))))